The Atari Compendium/The Atari Compendium (Toad Computers) (1994).iso/files/prgtools/editors/emcs1857/1857sr~1.zoo/lisp/emphasis.el

Text File | 1992-01-24 | 5.5 KB | 205 lines

;; Display characters with emphasis.
;; Copyright (C) 1987 Free Software Foundation, Inc.

;; This file is part of GNU Emacs.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY.  No author or distributor
;; accepts responsibility to anyone for the consequences of using it
;; or for whether it serves any particular purpose or works at all,
;; unless he says so in writing.  Refer to the GNU Emacs General Public
;; License for full details.

;; Everyone is granted permission to copy, modify and redistribute
;; GNU Emacs, but only under the conditions described in the
;; GNU Emacs General Public License.   A copy of this license is
;; supposed to have been given to you along with GNU Emacs so you
;; can know your rights and responsibilities.  It should be in a
;; file named COPYING.  Among other things, the copyright notice
;; and this notice must be preserved on all copies.


;; Written by Howard Gayle.  See case-table.el for details.

;; This file uses the char table stuff to display characters
;; with emphasis, e.g. underlined.  The high order bit is set for
;; emphasis.  This implies a 7-bit character set, so this file
;; will not mix with ISO 8859.

(defvar emphasis-char-table nil "Char table where high bit set for emphasis.")

(defvar deemphasize-trans-table nil "Trans table to set high bit.")
(if deemphasize-trans-table nil
   (setq deemphasize-trans-table (make-trans-table))
   (let     (
           (i 128)
     )
      (while (<= i 255)
           (set-trans-table-to i (- i 128) deemphasize-trans-table)
           (setq i (1+ i))
      )
   )
)

(defvar emphasize-trans-table nil "Trans table to set high bit.")
(if emphasize-trans-table nil
   (setq emphasize-trans-table (make-trans-table))
   (let     (
           (i 32)
     )
      (while (<= i 127)
           (set-trans-table-to i (+ i 128) emphasize-trans-table)
           (setq i (1+ i))
      )
   )
)

(defvar start-emphasis nil "Bytes to terminal to start emphasis.")
(defvar stop-emphasis  nil "Bytes to terminal to stop emphasis.")

(defun emphasis-on ()
   "Use emphasis char table in selected window, if possible."
   (interactive)
   (init-emphasis-char-table-maybe)
   (if emphasis-char-table (set-window-char-table emphasis-char-table))
)

(defun deemphasize-region (b e)
   "Emphasize the characters in region."
   (interactive "*r")
   (translate-region b e deemphasize-trans-table)
)


(defun emphasize-manual-entry ()
   "Convert backspace underlining and overstriking to emphasis
in the current buffer."
   (interactive)
   (let  (
           (buffer-read-only nil)
     )
      (init-emphasis-char-table-maybe)
      (if (and emphasis-char-table
                 (underline-to-emphasis-region (point-min) (point-max)))
           (setq buffer-char-table emphasis-char-table)
      )
   )
)

(setq manual-entry-hook 'emphasize-manual-entry)

(defun emphasize-region (b e)
   "Emphasize the characters in region."
   (interactive "*r")
   (translate-region b e emphasize-trans-table)
)

(defun init-emphasis-char-table ()
   "Initialize emphasis char table."
   (interactive)
   (setq emphasis-char-table (copy-char-table))
   (let  (
     (i 0) ; Current character.
     j     ; Rope index.
     r     ; Rope.
     )
      (while (<= i 127)
     (setq r (get-char-table-dispr emphasis-char-table i))
     (setq j 0)
     (while (< j (length r))
        (aset r j (get-glyf (concat start-emphasis
                    (glyf-to-string (aref r j))
                    stop-emphasis)))
        (setq j (1+ j))
     )
     (put-char-table-dispr emphasis-char-table (+ i 128) r)
     (setq i (1+ i))
      )
   )
)

(defun init-emphasis-char-table-maybe ()
   "Initialize emphasis char table if necessary."
   (cond
      (emphasis-char-table)
      ((or (not (stringp start-emphasis))
     (not (stringp stop-emphasis)))
     (message "start-emphasis and stop-emphasis must be set."))
      (t
     (message "Making emphasis char table...")
     (init-emphasis-char-table)
     (message "Making emphasis char table...done")
      )
   )
)

(defun underline-to-emphasis-buffer ()
   "Convert backspace underlining and overstriking to emphasis
in the current buffer."
   (interactive)
   (let  (
           (buffer-read-only nil)
     )
      (if (underline-to-emphasis-region (point-min) (point-max))
           (emphasis-on)
      )
   )
)

(defun underline-to-emphasis-region (b e)
   "Convert backspace underlining and overstriking to emphasis
in the region.  Returns t iff any changes made."
   (interactive "*r")
   (let     (
           (em (make-marker)) ; End marker.
     fc                     ; Character following backspace.
     pc                     ; Character preceding backspace.
     tmp                    ; Temporary.
     z                      ; Return.
           )
      (if (< e b)
           (progn
        (setq tmp b)
        (setq b e)
        (setq e tmp)
     )
      )
      (move-marker em e)
      (save-excursion
           (goto-char b)
           (while (search-forward "\b" em t)
              (setq pc (char-after (- (point) 2)))
        (setq fc (following-char))
        (cond
           ((= pc ?_)
          (forward-char 1)
          (delete-char -3)
          (insert (get-trans-table-to fc emphasize-trans-table))
          (setq z t)
           )
           ((= fc ?_)
          (forward-char 1)
          (delete-char -3)
          (insert (get-trans-table-to pc emphasize-trans-table))
          (setq z t)
           )
           ((= pc fc)
                 (setq tmp (- (point) 2))
          (forward-char 1)
          (while (and (= (following-char) ?\b)
                  (= (char-after (1+ (point))) pc))
             (forward-char 2)
          )
          (delete-region tmp (point))
          (insert (get-trans-table-to pc emphasize-trans-table))
          (setq z t)
           )
        )
     )
      )
      z
   )
)

(provide 'emphasis)